knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(R.utils)
library(wbCorr)
library(readxl)
library(kableExtra)
library(brms)
library(bayesplot)
top_directory <- file.path(
'C:', 'Users', 'kueng', 'OneDrive - Universität Zürich UZH',
'04 Papers', '02 T&T Control', 'Analysis', 'ACTIVITY', 'BRMS'
)
working_directory <- file.path(top_directory, 'SensitivityExcludePushing')
setwd(working_directory)
functions_directory <- file.path('C:', 'Users', 'kueng',
'OneDrive - Universität Zürich UZH',
'RFunctions')
source(file.path(functions_directory, 'ReportModels.R'))
source(file.path(functions_directory, 'PrettyTables.R'))
source(file.path(functions_directory, 'ReportMeasures.R'))
source(file.path(top_directory, 'Functions', 'PrepareData.R'))## [1] 1116
# Set options for analysis
use_mi = FALSE
shutdown = FALSE
report_ordinal = FALSE
options(
dplyr.print_max = 100,
brms.backend = 'cmdstan',
brms.file_refit = ifelse(use_mi, 'never', 'on_change'),
error = function() beepr::beep(sound = 5)
)df <- openxlsx::read.xlsx(file.path(top_directory, 'long.xlsx'))
df_original <- df
# Importantly, we do not recode pushing here.
df_double <- prepare_data(df, recode_pushing = FALSE, use_mi = use_mi)[[1]]Constructing scales reshaping data (4field) centering data within and between
# For indistinguishable Dyads
model_rows_fixed <- c(
'Intercept',
# '-- WITHIN PERSON MAIN EFFECTS --',
'persuasion_self_cw',
'persuasion_partner_cw',
'pressure_self_cw',
'pressure_partner_cw',
'pushing_self_cw',
'pushing_partner_cw',
'day',
'weartime_self_cw',
# '-- BETWEEN PERSON MAIN EFFECTS',
'persuasion_self_cb',
'persuasion_partner_cb',
'pressure_self_cb',
'pressure_partner_cb',
'pushing_self_cb',
'pushing_partner_cb',
'weartime_self_cb'
)
model_rows_fixed_ordinal <- c(
model_rows_fixed[1],
'Intercept[1]',
'Intercept[2]',
'Intercept[3]',
'Intercept[4]',
'Intercept[5]',
model_rows_fixed[2:length(model_rows_fixed)]
)
model_rows_random <- c(
# '--------------',
# '-- RANDOM EFFECTS --',
'sd(Intercept)',
'sd(persuasion_self_cw)',
'sd(persuasion_partner_cw)',
'sd(pressure_self_cw)',
'sd(pressure_partner_cw)',
'sd(pushing_self_cw)',
'sd(pushing_partner_cw)',
# '-- CORRELATION STRUCTURE -- ',
'ar[1]',
'nu',
'shape',
'sderr',
'sigma'
)
model_rows_random_ordinal <- c(model_rows_random,'disc')# For indistinguishable Dyads
model_rownames_fixed <- c(
'Intercept',
# '-- WITHIN PERSON MAIN EFFECTS --',
'Daily perceived persuasion target -> target',
'Daily perceived persuasion target -> agent',
'Daily perceived pressure target -> target',
'Daily perceived pressure target -> agent',
'Daily perceived pushing target -> target',
'Daily perceived pushing target -> agent',
'Day',
'Daily weartime',
# '-- BETWEEN PERSON MAIN EFFECTS',
'Mean perceived persuasion target -> target',
'Mean Perceived persuasion target -> agent',
'Mean Perceived pressure target -> target',
'Mean Perceived pressure target -> agent',
'Mean Perceived pushing target -> target',
'Mean Perceived pushing target -> agent',
'Mean weartime'
)
model_rownames_fixed_ordinal <- c(
model_rownames_fixed[1],
'Intercept[1]',
'Intercept[2]',
'Intercept[3]',
'Intercept[4]',
'Intercept[5]',
model_rownames_fixed[2:length(model_rownames_fixed)]
)
model_rownames_random <- c(
# '--------------',
# '-- RANDOM EFFECTS --',
'sd(Intercept)',
'sd(Daily perceived persuasion target -> target)',
'sd(Daily perceived persuasion target -> agent)',
'sd(Daily perceived pressure target -> target)',
'sd(Daily perceived pressure target -> agent)',
'sd(Daily perceived pushing target -> target)',
'sd(Daily perceived pushing target -> agent)',
# '-- CORRELATION STRUCTURE -- ',
'ar[1]',
'nu',
'shape',
'sderr',
'sigma'
)
model_rownames_random_ordinal <- c(model_rownames_random,'disc')rows_to_pack <- list(
"Within-Person Effects" = c(2,9),
"Between-Person Effects" = c(10,16),
"Random Effects" = c(17, 23),
"Additional Parameters" = c(24,28)
)
rows_to_pack_ordinal <- list(
"Intercepts" = c(1,6),
"Within-Person Effects" = c(2+5,9+5),
"Between-Person Effects" = c(10+5,16+5),
"Random Effects" = c(17+5, 23+5),
"Additional Parameters" = c(24+5,28+6)
)## [1] 0 720
Modelling using the gaussian family fails. Due to the many zeros, transformations won’t help estimating the models. We employ the negative binomial family.
formula <- bf(
pa_sub ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 2.5)", class = "b"),
brms::set_prior("normal(0, 50)", class = "Intercept", lb = 0),
brms::set_prior("normal(0, 10)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 20)", class = "shape"),
brms::set_prior("cauchy(0, 10)", class='sderr')
)
#df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
pa_sub <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = brms::negbinomial(),
#control = list(adapt_delta = 0.99),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory, "models_cache", "pa_sub")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 3736 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -12063.0 177.5
## p_loo 25.5 2.5
## looic 24126.0 355.0
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.7, 2.0]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
pa_sub,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| IRR | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 27.62* | 21.21 | 36.13 | 1.000 | 4396.32 | 6870.13 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 1.23* | 1.11 | 1.38 | 1.000 | 12988.93 | 8574.84 |
| Daily perceived persuasion target -> agent | 1.23* | 1.10 | 1.38 | 1.001 | 15060.56 | 8767.08 |
| Daily perceived pressure target -> target | 0.98 | 0.76 | 1.30 | 1.000 | 13032.32 | 8352.08 |
| Daily perceived pressure target -> agent | 1.20 | 0.92 | 1.64 | 1.001 | 13766.28 | 7660.73 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | 0.79 | 0.57 | 1.09 | 1.000 | 16150.65 | 9569.59 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | 1.92* | 1.06 | 3.50 | 1.001 | 3450.18 | 6236.16 |
| Mean Perceived persuasion target -> agent | 1.48 | 0.82 | 2.70 | 1.001 | 3382.42 | 5875.37 |
| Mean Perceived pressure target -> target | 0.52 | 0.26 | 1.07 | 1.001 | 4776.29 | 7468.80 |
| Mean Perceived pressure target -> agent | 0.48* | 0.23 | 0.98 | 1.000 | 4752.09 | 7028.15 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.61 | 0.45 | 0.82 | 1.00 | 4099.30 | 7134.15 |
| sd(Daily perceived persuasion target -> target) | 0.10 | 0.01 | 0.24 | 1.00 | 4112.73 | 5072.74 |
| sd(Daily perceived persuasion target -> agent) | 0.09 | 0.00 | 0.22 | 1.00 | 5697.03 | 5154.91 |
| sd(Daily perceived pressure target -> target) | 0.16 | 0.01 | 0.48 | 1.00 | 7470.24 | 5432.88 |
| sd(Daily perceived pressure target -> agent) | 0.16 | 0.01 | 0.47 | 1.00 | 6702.82 | 5139.14 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.03 | -0.94 | 0.95 | 1.00 | 13384.91 | 7962.52 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | 0.14 | 0.13 | 0.14 | 1.00 | 19696.23 | 8770.87 |
| sderr | 0.05 | 0.00 | 0.14 | 1.00 | 6332.51 | 5494.46 |
| sigma | NA | NA | NA | NA | NA | NA |
## [1] 5.75 971.25
We tried negative binomial here as well for consistency, but the model did not converge. Poisson also did not work. As we have no zeros in this distribution, we log transform.
formula <- bf(
pa_obj_log ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day + weartime_self_cw + weartime_self_cb +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 2.5)", class = "b"),
brms::set_prior("normal(0, 50)", class = "Intercept", lb = 0),
brms::set_prior("normal(0, 10)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
#df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
pa_obj_log <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.99),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory,"models_cache", "pa_obj_log")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 3337 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -2814.1 56.5
## p_loo 76.1 3.5
## looic 5628.2 112.9
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.5, 2.0]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
pa_obj_log,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| exp(Est.) | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 117.56* | 105.88 | 130.87 | 1.001 | 3404.69 | 5778.90 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 1.03* | 1.00 | 1.06 | 1.000 | 9119.57 | 9566.41 |
| Daily perceived persuasion target -> agent | 1.02 | 1.00 | 1.05 | 1.000 | 12588.33 | 9534.85 |
| Daily perceived pressure target -> target | 0.96 | 0.90 | 1.02 | 1.000 | 15588.29 | 9536.49 |
| Daily perceived pressure target -> agent | 1.00 | 0.94 | 1.06 | 1.000 | 17483.33 | 8949.00 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | 0.96 | 0.88 | 1.05 | 1.000 | 23231.60 | 8725.63 |
| Daily weartime | 1.00* | 1.00 | 1.00 | 1.001 | 12693.36 | 8293.97 |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | 1.11 | 0.86 | 1.44 | 1.001 | 3157.83 | 5272.51 |
| Mean Perceived persuasion target -> agent | 1.04 | 0.80 | 1.34 | 1.000 | 3171.23 | 5299.71 |
| Mean Perceived pressure target -> target | 0.89 | 0.66 | 1.20 | 1.000 | 4452.45 | 7128.86 |
| Mean Perceived pressure target -> agent | 1.03 | 0.77 | 1.36 | 1.000 | 4133.67 | 6774.70 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | 1.00 | 1.00 | 1.00 | 1.000 | 14971.08 | 9814.29 |
| Random Effects | ||||||
| sd(Intercept) | 0.29 | 0.23 | 0.38 | 1.00 | 3555.00 | 5900.40 |
| sd(Daily perceived persuasion target -> target) | 0.05 | 0.03 | 0.08 | 1.00 | 3842.69 | 2951.85 |
| sd(Daily perceived persuasion target -> agent) | 0.05 | 0.02 | 0.08 | 1.00 | 6245.52 | 5849.70 |
| sd(Daily perceived pressure target -> target) | 0.05 | 0.00 | 0.15 | 1.00 | 5137.97 | 5713.28 |
| sd(Daily perceived pressure target -> agent) | 0.04 | 0.00 | 0.11 | 1.00 | 7532.11 | 6305.39 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.29 | 0.26 | 0.33 | 1.00 | 21158.65 | 9287.65 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.56 | 0.54 | 0.57 | 1.00 | 23043.84 | 8821.59 |
## [1] 1 6
formula <- bf(
aff ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=6), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
mood <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory,"models_cache", "mood")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 3736 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -4822.7 63.5
## p_loo 78.0 4.1
## looic 9645.5 127.0
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 2.0]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
mood,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = F) %>%
print_df(rows_to_pack = rows_to_pack)| b | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 4.73* | 4.53 | 4.94 | 1.002 | 1716.09 | 3122.36 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 0.00 | -0.03 | 0.04 | 1.000 | 9332.87 | 8854.00 |
| Daily perceived persuasion target -> agent | 0.03 | -0.01 | 0.07 | 1.000 | 7856.25 | 7357.56 |
| Daily perceived pressure target -> target | -0.04 | -0.15 | 0.06 | 1.000 | 7041.41 | 5609.21 |
| Daily perceived pressure target -> agent | -0.01 | -0.13 | 0.10 | 1.000 | 6552.58 | 6855.80 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | 0.21* | 0.05 | 0.38 | 1.000 | 13525.46 | 9099.08 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | 0.45 | -0.06 | 0.96 | 1.002 | 1462.86 | 3152.25 |
| Mean Perceived persuasion target -> agent | 0.39 | -0.13 | 0.89 | 1.002 | 1488.68 | 3028.63 |
| Mean Perceived pressure target -> target | -0.37 | -0.95 | 0.20 | 1.001 | 1827.31 | 3822.35 |
| Mean Perceived pressure target -> agent | -0.33 | -0.90 | 0.25 | 1.001 | 1831.02 | 3565.39 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.59 | 0.46 | 0.77 | 1.00 | 2191.90 | 4697.16 |
| sd(Daily perceived persuasion target -> target) | 0.03 | 0.00 | 0.08 | 1.00 | 3325.05 | 3968.88 |
| sd(Daily perceived persuasion target -> agent) | 0.06 | 0.01 | 0.12 | 1.00 | 2332.23 | 2037.73 |
| sd(Daily perceived pressure target -> target) | 0.11 | 0.01 | 0.28 | 1.00 | 3300.86 | 4940.13 |
| sd(Daily perceived pressure target -> agent) | 0.14 | 0.01 | 0.32 | 1.00 | 2638.59 | 2694.23 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.45 | 0.42 | 0.48 | 1.00 | 11217.59 | 8994.39 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.87 | 0.85 | 0.89 | 1.00 | 13713.27 | 8785.84 |
## [1] 0 5
formula <- bf(
reactance ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=5), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
reactance <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory,"models_cache", "reactance")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 756 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -1059.7 35.6
## p_loo 62.9 6.7
## looic 2119.4 71.1
## ------
## MCSE of elpd_loo is NA.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.5, 1.8]).
##
## Pareto k diagnostic values:
## Count Pct. Min. ESS
## (-Inf, 0.7] (good) 748 98.9% 217
## (0.7, 1] (bad) 8 1.1% <NA>
## (1, Inf) (very bad) 0 0.0% <NA>
## See help('pareto-k-diagnostic') for details.
## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: reactance ~ persuasion_self_cw + persuasion_partner_cw + pressure_self_cw + pressure_partner_cw + persuasion_self_cb + persuasion_partner_cb + pressure_self_cb + pressure_partner_cb + day + (persuasion_self_cw + persuasion_partner_cw + pressure_self_cw + pressure_partner_cw | coupleID)
## autocor ~ ar(time = day, gr = coupleID:userID, p = 1)
## Data: data (Number of observations: 756)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Correlation Structures:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## ar[1] 0.01 0.04 -0.07 0.09 1.00 16544 8503
##
## Multilevel Hyperparameters:
## ~coupleID (Number of levels: 38)
## Estimate Est.Error l-95% CI u-95% CI Rhat
## sd(Intercept) 0.29 0.07 0.17 0.44 1.00
## sd(persuasion_self_cw) 0.05 0.04 0.00 0.14 1.00
## sd(persuasion_partner_cw) 0.04 0.03 0.00 0.12 1.00
## sd(pressure_self_cw) 0.36 0.10 0.19 0.58 1.00
## sd(pressure_partner_cw) 0.22 0.16 0.01 0.60 1.00
## cor(Intercept,persuasion_self_cw) -0.29 0.37 -0.84 0.54 1.00
## cor(Intercept,persuasion_partner_cw) 0.14 0.38 -0.65 0.80 1.00
## cor(persuasion_self_cw,persuasion_partner_cw) -0.06 0.41 -0.78 0.73 1.00
## cor(Intercept,pressure_self_cw) 0.10 0.29 -0.44 0.66 1.00
## cor(persuasion_self_cw,pressure_self_cw) -0.00 0.38 -0.72 0.71 1.00
## cor(persuasion_partner_cw,pressure_self_cw) 0.00 0.40 -0.74 0.75 1.00
## cor(Intercept,pressure_partner_cw) 0.10 0.34 -0.58 0.73 1.00
## cor(persuasion_self_cw,pressure_partner_cw) 0.09 0.40 -0.70 0.78 1.00
## cor(persuasion_partner_cw,pressure_partner_cw) -0.00 0.41 -0.75 0.75 1.00
## cor(pressure_self_cw,pressure_partner_cw) -0.21 0.36 -0.79 0.57 1.00
## Bulk_ESS Tail_ESS
## sd(Intercept) 5164 8174
## sd(persuasion_self_cw) 3307 5608
## sd(persuasion_partner_cw) 6819 7138
## sd(pressure_self_cw) 6384 8244
## sd(pressure_partner_cw) 3397 6191
## cor(Intercept,persuasion_self_cw) 10375 8526
## cor(Intercept,persuasion_partner_cw) 19102 9072
## cor(persuasion_self_cw,persuasion_partner_cw) 14139 9317
## cor(Intercept,pressure_self_cw) 5931 7887
## cor(persuasion_self_cw,pressure_self_cw) 3870 6623
## cor(persuasion_partner_cw,pressure_self_cw) 3364 7105
## cor(Intercept,pressure_partner_cw) 12414 9348
## cor(persuasion_self_cw,pressure_partner_cw) 7709 9756
## cor(persuasion_partner_cw,pressure_partner_cw) 8479 9066
## cor(pressure_self_cw,pressure_partner_cw) 10277 9170
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept 0.52 0.09 0.35 0.71 1.00 14944 10402
## persuasion_self_cw -0.04 0.03 -0.10 0.01 1.00 16923 9610
## persuasion_partner_cw 0.00 0.03 -0.06 0.07 1.00 18981 9161
## pressure_self_cw 0.30 0.10 0.09 0.50 1.00 10810 9216
## pressure_partner_cw 0.13 0.11 -0.06 0.38 1.00 8601 7353
## persuasion_self_cb -0.03 0.18 -0.38 0.33 1.00 7526 8537
## persuasion_partner_cb -0.05 0.19 -0.43 0.33 1.00 8110 8273
## pressure_self_cb 0.67 0.21 0.26 1.08 1.00 8665 8862
## pressure_partner_cb 0.17 0.22 -0.26 0.60 1.00 8869 8832
## day 0.13 0.13 -0.13 0.39 1.00 21317 9159
##
## Further Distributional Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.94 0.03 0.89 0.99 1.00 15360 8934
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
summarize_brms(
reactance,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = F) %>%
print_df(rows_to_pack = rows_to_pack)| b | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 0.52* | 0.35 | 0.71 | 1.001 | 14944.50 | 10401.85 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | -0.04 | -0.10 | 0.01 | 1.001 | 16923.04 | 9610.39 |
| Daily perceived persuasion target -> agent | 0.00 | -0.06 | 0.07 | 1.000 | 18981.22 | 9161.22 |
| Daily perceived pressure target -> target | 0.30* | 0.09 | 0.50 | 1.000 | 10809.84 | 9215.85 |
| Daily perceived pressure target -> agent | 0.13 | -0.06 | 0.38 | 1.000 | 8600.93 | 7352.69 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | 0.13 | -0.13 | 0.39 | 1.000 | 21316.60 | 9158.65 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | -0.03 | -0.38 | 0.33 | 1.000 | 7526.02 | 8537.01 |
| Mean Perceived persuasion target -> agent | -0.05 | -0.43 | 0.33 | 1.000 | 8110.13 | 8272.75 |
| Mean Perceived pressure target -> target | 0.67* | 0.26 | 1.08 | 1.000 | 8665.22 | 8862.10 |
| Mean Perceived pressure target -> agent | 0.17 | -0.26 | 0.60 | 1.000 | 8868.64 | 8832.09 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.29 | 0.17 | 0.44 | 1.00 | 5163.87 | 8174.06 |
| sd(Daily perceived persuasion target -> target) | 0.05 | 0.00 | 0.14 | 1.00 | 3307.06 | 5608.38 |
| sd(Daily perceived persuasion target -> agent) | 0.04 | 0.00 | 0.12 | 1.00 | 6818.84 | 7138.47 |
| sd(Daily perceived pressure target -> target) | 0.36 | 0.19 | 0.58 | 1.00 | 6383.71 | 8244.12 |
| sd(Daily perceived pressure target -> agent) | 0.22 | 0.01 | 0.60 | 1.00 | 3397.27 | 6190.63 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.01 | -0.07 | 0.09 | 1.00 | 16544.12 | 8502.57 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.94 | 0.89 | 0.99 | 1.00 | 15359.55 | 8933.85 |
introduce_binary_reactance <- function(data) {
data$is_reactance <- factor(data$reactance > 0, levels = c(FALSE, TRUE), labels = c(0, 1))
return(data)
}
df_double <- introduce_binary_reactance(df_double)
if (use_mi) {
for (i in seq_along(implist)) {
implist[[i]] <- introduce_binary_reactance(implist[[i]])
}
}
formula <- bf(
is_reactance ~
persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw +
persuasion_self_cb + persuasion_partner_cb +
pressure_self_cb + pressure_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw +
pressure_self_cw + pressure_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=5), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1)
#brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
is_reactance <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = bernoulli(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory, "models_cache", "is_reactance")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 756 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -364.3 14.0
## p_loo 306.2 12.4
## looic 728.5 28.1
## ------
## MCSE of elpd_loo is NA.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.7, 1.2]).
##
## Pareto k diagnostic values:
## Count Pct. Min. ESS
## (-Inf, 0.7] (good) 8 1.1% 1466
## (0.7, 1] (bad) 419 55.4% <NA>
## (1, Inf) (very bad) 329 43.5% <NA>
## See help('pareto-k-diagnostic') for details.
summarize_brms(
is_reactance,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| OR | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 0.01* | 0.00 | 0.13 | 1.001 | 2749.86 | 4423.58 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | 0.50 | 0.20 | 1.02 | 1.001 | 4086.94 | 5936.70 |
| Daily perceived persuasion target -> agent | 1.81 | 0.65 | 7.29 | 1.000 | 3915.55 | 4560.08 |
| Daily perceived pressure target -> target | 19.53* | 2.98 | 234.47 | 1.001 | 2797.11 | 4677.16 |
| Daily perceived pressure target -> agent | 2.21 | 0.24 | 26.84 | 1.000 | 6149.05 | 6661.16 |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Day | 10.46 | 0.51 | 372.66 | 1.000 | 4775.91 | 6181.19 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | 21.18 | 0.42 | 2262.08 | 1.001 | 3477.42 | 5598.48 |
| Mean Perceived persuasion target -> agent | 2.01 | 0.04 | 153.86 | 1.000 | 4462.33 | 5846.62 |
| Mean Perceived pressure target -> target | 7080.85* | 27.83 | 3411584.83 | 1.000 | 5516.30 | 6872.82 |
| Mean Perceived pressure target -> agent | 4.26 | 0.01 | 1913.20 | 1.001 | 5783.43 | 6644.51 |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 4.13 | 2.36 | 6.31 | 1.00 | 2465.10 | 2691.07 |
| sd(Daily perceived persuasion target -> target) | 0.63 | 0.03 | 1.69 | 1.00 | 1753.02 | 4222.14 |
| sd(Daily perceived persuasion target -> agent) | 1.64 | 0.49 | 3.21 | 1.00 | 2580.22 | 3439.80 |
| sd(Daily perceived pressure target -> target) | 1.63 | 0.06 | 4.23 | 1.00 | 1984.12 | 4362.89 |
| sd(Daily perceived pressure target -> agent) | 1.43 | 0.06 | 3.98 | 1.00 | 4213.88 | 5269.34 |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.09 | -0.10 | 0.29 | 1.00 | 2204.21 | 3748.62 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | 7.44 | 3.85 | 11.98 | 1.00 | 1750.32 | 1964.64 |
| sigma | NA | NA | NA | NA | NA | NA |
if (report_ordinal) {
model_rows_random_final <- model_rows_random_ordinal
model_rows_fixed_final <- model_rows_fixed_ordinal
model_rownames_fixed_final <- model_rownames_fixed_ordinal
model_rownames_random_final <- model_rownames_random_ordinal
rows_to_pack_final <- rows_to_pack_ordinal
} else {
model_rows_random_final <- model_rows_random
model_rows_fixed_final <- model_rows_fixed
model_rownames_fixed_final <- model_rownames_fixed
model_rownames_random_final <- model_rownames_random
rows_to_pack_final <- rows_to_pack
}
all_models <- report_side_by_side(
pa_sub,
pa_obj_log,
mood,
reactance,
is_reactance,
model_rows_random = model_rows_random_final,
model_rows_fixed = model_rows_fixed_final,
model_rownames_random = model_rownames_random_final,
model_rownames_fixed = model_rownames_fixed_final
) ## [1] "pa_sub"
## [1] "pa_obj_log"
## [1] "mood"
## [1] "reactance"
## [1] "is_reactance"
# pretty printing
summary_all_models <- all_models %>%
print_df(rows_to_pack = rows_to_pack_final) %>%
add_header_above(
c(" ", "Subjective MVPA" = 2,
"Device-Based MVPA" = 2,
"Mood" = 2,
"Reactance Gaussian" = 2,
"Reactance Dichotome" = 2)
)
export_xlsx(summary_all_models,
rows_to_pack = rows_to_pack_final,
file.path(working_directory, "OutputFinal", "AllModels_noPushing.xlsx"),
merge_option = 'both',
simplify_2nd_row = TRUE,
colwidths = c(40, 7.4, 12.85, 7.4, 12.85,7.4, 12.85,7.4, 12.85,7.4, 12.85),
line_above_rows = c(1,2,3,21),
line_below_rows = c(-1))##
## Attaching package: 'rvest'
## The following object is masked from 'package:readr':
##
## guess_encoding
| IRR pa_sub | 95% CI pa_sub | exp(Est.) pa_obj_log | 95% CI pa_obj_log | b mood | 95% CI mood | b reactance | 95% CI reactance | OR is_reactance | 95% CI is_reactance | |
|---|---|---|---|---|---|---|---|---|---|---|
| Intercept | 27.62* | [21.21, 36.13] | 117.56* | [105.88, 130.87] | 4.73* | [ 4.53, 4.94] | 0.52* | [ 0.35, 0.71] | 0.01* | [ 0.00, 0.13] |
| Within-Person Effects | ||||||||||
| Daily perceived persuasion target -> target | 1.23* | [ 1.11, 1.38] | 1.03* | [ 1.00, 1.06] | 0.00 | [-0.03, 0.04] | -0.04 | [-0.10, 0.01] | 0.50 | [ 0.20, 1.02] |
| Daily perceived persuasion target -> agent | 1.23* | [ 1.10, 1.38] | 1.02 | [ 1.00, 1.05] | 0.03 | [-0.01, 0.07] | 0.00 | [-0.06, 0.07] | 1.81 | [ 0.65, 7.29] |
| Daily perceived pressure target -> target | 0.98 | [ 0.76, 1.30] | 0.96 | [ 0.90, 1.02] | -0.04 | [-0.15, 0.06] | 0.30* | [ 0.09, 0.50] | 19.53* | [ 2.98, 234.47] |
| Daily perceived pressure target -> agent | 1.20 | [ 0.92, 1.64] | 1.00 | [ 0.94, 1.06] | -0.01 | [-0.13, 0.10] | 0.13 | [-0.06, 0.38] | 2.21 | [ 0.24, 26.84] |
| Daily perceived pushing target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Day | 0.79 | [ 0.57, 1.09] | 0.96 | [ 0.88, 1.05] | 0.21* | [ 0.05, 0.38] | 0.13 | [-0.13, 0.39] | 10.46 | [ 0.51, 372.66] |
| Daily weartime | NA | NA | 1.00* | [ 1.00, 1.00] | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||||||
| Mean perceived persuasion target -> target | 1.92* | [ 1.06, 3.50] | 1.11 | [ 0.86, 1.44] | 0.45 | [-0.06, 0.96] | -0.03 | [-0.38, 0.33] | 21.18 | [ 0.42, 2262.08] |
| Mean Perceived persuasion target -> agent | 1.48 | [ 0.82, 2.70] | 1.04 | [ 0.80, 1.34] | 0.39 | [-0.13, 0.89] | -0.05 | [-0.43, 0.33] | 2.01 | [ 0.04, 153.86] |
| Mean Perceived pressure target -> target | 0.52 | [ 0.26, 1.07] | 0.89 | [ 0.66, 1.20] | -0.37 | [-0.95, 0.20] | 0.67* | [ 0.26, 1.08] | 7080.85* | [27.83, 3411584.83] |
| Mean Perceived pressure target -> agent | 0.48* | [ 0.23, 0.98] | 1.03 | [ 0.77, 1.36] | -0.33 | [-0.90, 0.25] | 0.17 | [-0.26, 0.60] | 4.26 | [ 0.01, 1913.20] |
| Mean Perceived pushing target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean weartime | NA | NA | 1.00 | [ 1.00, 1.00] | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||||||
| sd(Intercept) | 0.61 | [ 0.45, 0.82] | 0.29 | [0.23, 0.38] | 0.59 | [0.46, 0.77] | 0.29 | [ 0.17, 0.44] | 4.13 | [ 2.36, 6.31] |
| sd(Daily perceived persuasion target -> target) | 0.10 | [ 0.01, 0.24] | 0.05 | [0.03, 0.08] | 0.03 | [0.00, 0.08] | 0.05 | [ 0.00, 0.14] | 0.63 | [ 0.03, 1.69] |
| sd(Daily perceived persuasion target -> agent) | 0.09 | [ 0.00, 0.22] | 0.05 | [0.02, 0.08] | 0.06 | [0.01, 0.12] | 0.04 | [ 0.00, 0.12] | 1.64 | [ 0.49, 3.21] |
| sd(Daily perceived pressure target -> target) | 0.16 | [ 0.01, 0.48] | 0.05 | [0.00, 0.15] | 0.11 | [0.01, 0.28] | 0.36 | [ 0.19, 0.58] | 1.63 | [ 0.06, 4.23] |
| sd(Daily perceived pressure target -> agent) | 0.16 | [ 0.01, 0.47] | 0.04 | [0.00, 0.11] | 0.14 | [0.01, 0.32] | 0.22 | [ 0.01, 0.60] | 1.43 | [ 0.06, 3.98] |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||||||
| ar[1] | 0.03 | [-0.94, 0.95] | 0.29 | [0.26, 0.33] | 0.45 | [0.42, 0.48] | 0.01 | [-0.07, 0.09] | 0.09 | [-0.10, 0.29] |
| nu | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| shape | 0.14 | [ 0.13, 0.14] | NA | NA | NA | NA | NA | NA | NA | NA |
| sderr | 0.05 | [ 0.00, 0.14] | NA | NA | NA | NA | NA | NA | 7.44 | [ 3.85, 11.98] |
| sigma | NA | NA | 0.56 | [0.54, 0.57] | 0.87 | [0.85, 0.89] | 0.94 | [ 0.89, 0.99] | NA | NA |
Without recoding NAs.
formula <- bf(
pa_sub ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day +
# Random effects
(pushing_self_cw + pushing_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 2.5)", class = "b"),
brms::set_prior("normal(0, 50)", class = "Intercept", lb = 0),
brms::set_prior("normal(0, 10)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 20)", class = "shape"),
brms::set_prior("cauchy(0, 10)", class='sderr')
)
#df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
pa_sub <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = brms::negbinomial(),
#control = list(adapt_delta = 0.99),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory, "models_cache", "pa_sub_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 1342 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -6325.4 67.4
## p_loo 26.7 2.3
## looic 12650.7 134.8
## ------
## MCSE of elpd_loo is NA.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 2.1]).
##
## Pareto k diagnostic values:
## Count Pct. Min. ESS
## (-Inf, 0.7] (good) 1341 99.9% 590
## (0.7, 1] (bad) 1 0.1% <NA>
## (1, Inf) (very bad) 0 0.0% <NA>
## See help('pareto-k-diagnostic') for details.
summarize_brms(
pa_sub,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| IRR | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 51.60* | 38.12 | 69.14 | 1.001 | 6499.88 | 7693.29 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 1.10 | 0.98 | 1.25 | 1.000 | 19444.87 | 9675.36 |
| Daily perceived pushing target -> agent | 1.11 | 0.99 | 1.26 | 1.000 | 19917.50 | 9408.07 |
| Day | 0.66* | 0.49 | 0.89 | 1.000 | 22094.96 | 9219.89 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.61* | 0.42 | 0.88 | 1.001 | 8339.11 | 9717.91 |
| Mean Perceived pushing target -> agent | 0.56* | 0.38 | 0.80 | 1.001 | 7738.07 | 9616.77 |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.74 | 0.53 | 1.01 | 1.00 | 3972.17 | 6902.31 |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.09 | 0.00 | 0.24 | 1.00 | 6160.40 | 7035.53 |
| sd(Daily perceived pushing target -> agent) | 0.09 | 0.00 | 0.23 | 1.00 | 6932.74 | 8275.95 |
| Additional Parameters | ||||||
| ar[1] | 0.04 | -0.93 | 0.94 | 1.00 | 18362.56 | 7775.79 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | 0.43 | 0.40 | 0.47 | 1.00 | 22915.16 | 8641.75 |
| sderr | 0.05 | 0.00 | 0.13 | 1.00 | 7805.33 | 6346.97 |
| sigma | NA | NA | NA | NA | NA | NA |
formula <- bf(
pa_obj_log ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day + weartime_self_cw + weartime_self_cb +
# Random effects
(pushing_self_cw + pushing_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 2.5)", class = "b"),
brms::set_prior("normal(0, 50)", class = "Intercept", lb = 0),
brms::set_prior("normal(0, 10)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
#df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
pa_obj_log <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.99),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory, "models_cache", "pa_obj_log_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 1214 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -987.0 33.9
## p_loo 61.3 4.6
## looic 1974.1 67.9
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 2.2]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
pa_obj_log,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| exp(Est.) | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 126.23* | 111.44 | 143.02 | 1.000 | 4467.01 | 6764.04 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 1.02 | 0.96 | 1.08 | 1.000 | 8193.74 | 8282.32 |
| Daily perceived pushing target -> agent | 1.03 | 0.99 | 1.07 | 1.000 | 14673.57 | 8746.95 |
| Day | 0.94 | 0.82 | 1.07 | 1.000 | 19787.05 | 9160.97 |
| Daily weartime | 1.00* | 1.00 | 1.00 | 1.000 | 12405.43 | 8682.22 |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.98 | 0.85 | 1.12 | 1.000 | 8886.35 | 9415.38 |
| Mean Perceived pushing target -> agent | 1.05 | 0.91 | 1.20 | 1.000 | 8314.57 | 9113.38 |
| Mean weartime | 1.00 | 1.00 | 1.00 | 1.001 | 11227.20 | 10306.43 |
| Random Effects | ||||||
| sd(Intercept) | 0.30 | 0.22 | 0.40 | 1.00 | 3759.41 | 6873.09 |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.10 | 0.03 | 0.18 | 1.00 | 2754.58 | 2256.83 |
| sd(Daily perceived pushing target -> agent) | 0.04 | 0.00 | 0.11 | 1.00 | 3592.64 | 5418.37 |
| Additional Parameters | ||||||
| ar[1] | 0.27 | 0.21 | 0.34 | 1.00 | 13411.66 | 9546.96 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.53 | 0.51 | 0.55 | 1.00 | 17708.89 | 8678.38 |
formula <- bf(
aff ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day +
# Random effects
(pushing_self_cw + pushing_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=6), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
mood <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory, "models_cache", "mood_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 1342 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -1767.1 41.4
## p_loo 50.5 3.2
## looic 3534.3 82.9
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.5, 1.9]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
summarize_brms(
mood,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = F) %>%
print_df(rows_to_pack = rows_to_pack)| b | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 4.78* | 4.55 | 5.01 | 1.002 | 2075.35 | 3972.98 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 0.03 | -0.04 | 0.09 | 1.001 | 8891.49 | 7303.26 |
| Daily perceived pushing target -> agent | 0.08* | 0.01 | 0.15 | 1.000 | 6422.89 | 7936.48 |
| Day | 0.27* | 0.07 | 0.49 | 1.000 | 13820.47 | 9434.25 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.11 | -0.13 | 0.34 | 1.001 | 5569.00 | 7946.49 |
| Mean Perceived pushing target -> agent | 0.11 | -0.11 | 0.35 | 1.000 | 5347.07 | 7301.31 |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.60 | 0.46 | 0.78 | 1.00 | 2714.52 | 4967.45 |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.07 | 0.00 | 0.16 | 1.00 | 3665.31 | 3440.79 |
| sd(Daily perceived pushing target -> agent) | 0.10 | 0.01 | 0.20 | 1.00 | 4280.06 | 2659.02 |
| Additional Parameters | ||||||
| ar[1] | 0.27 | 0.22 | 0.33 | 1.00 | 13852.93 | 9114.84 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 0.89 | 0.85 | 0.92 | 1.00 | 14442.62 | 9370.63 |
formula <- bf(
reactance ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day +
# Random effects
(persuasion_self_cw + persuasion_partner_cw | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=5), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1),
brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
reactance <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = gaussian(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory, "models_cache", "reactance_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 403 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -597.1 24.8
## p_loo 37.2 4.8
## looic 1194.3 49.5
## ------
## MCSE of elpd_loo is 0.1.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.4, 1.7]).
##
## All Pareto k estimates are good (k < 0.7).
## See help('pareto-k-diagnostic') for details.
## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: reactance ~ pushing_self_cw + pushing_partner_cw + pushing_self_cb + pushing_partner_cb + day + (persuasion_self_cw + persuasion_partner_cw | coupleID)
## autocor ~ ar(time = day, gr = coupleID:userID, p = 1)
## Data: data (Number of observations: 403)
## Draws: 4 chains, each with iter = 5000; warmup = 2000; thin = 1;
## total post-warmup draws = 12000
##
## Correlation Structures:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## ar[1] 0.17 0.06 0.05 0.30 1.00 10072 8521
##
## Multilevel Hyperparameters:
## ~coupleID (Number of levels: 37)
## Estimate Est.Error l-95% CI u-95% CI Rhat
## sd(Intercept) 0.40 0.12 0.17 0.66 1.00
## sd(persuasion_self_cw) 0.10 0.06 0.01 0.22 1.00
## sd(persuasion_partner_cw) 0.08 0.05 0.00 0.19 1.00
## cor(Intercept,persuasion_self_cw) -0.49 0.40 -0.96 0.57 1.00
## cor(Intercept,persuasion_partner_cw) 0.20 0.45 -0.73 0.91 1.00
## cor(persuasion_self_cw,persuasion_partner_cw) -0.22 0.48 -0.93 0.78 1.00
## Bulk_ESS Tail_ESS
## sd(Intercept) 2884 4014
## sd(persuasion_self_cw) 2405 3991
## sd(persuasion_partner_cw) 4821 5824
## cor(Intercept,persuasion_self_cw) 4336 6718
## cor(Intercept,persuasion_partner_cw) 8982 8859
## cor(persuasion_self_cw,persuasion_partner_cw) 7155 7598
##
## Regression Coefficients:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept 0.41 0.12 0.17 0.66 1.00 10438 9437
## pushing_self_cw 0.11 0.04 0.03 0.19 1.00 18218 8864
## pushing_partner_cw -0.03 0.05 -0.13 0.06 1.00 17557 9239
## pushing_self_cb 0.39 0.14 0.12 0.66 1.00 12634 8878
## pushing_partner_cb 0.26 0.14 -0.01 0.54 1.00 13211 8912
## day 0.04 0.21 -0.37 0.45 1.00 16944 9097
##
## Further Distributional Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 1.02 0.04 0.94 1.10 1.00 9118 8183
##
## Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
summarize_brms(
reactance,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = F) %>%
print_df(rows_to_pack = rows_to_pack)| b | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 0.41* | 0.17 | 0.66 | 1.000 | 10437.80 | 9436.79 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 0.11* | 0.03 | 0.19 | 1.001 | 18217.94 | 8864.31 |
| Daily perceived pushing target -> agent | -0.03 | -0.13 | 0.06 | 1.000 | 17556.78 | 9239.13 |
| Day | 0.04 | -0.37 | 0.45 | 1.000 | 16944.38 | 9096.89 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.39* | 0.12 | 0.66 | 1.000 | 12633.86 | 8878.25 |
| Mean Perceived pushing target -> agent | 0.26 | -0.01 | 0.54 | 1.000 | 13210.82 | 8911.92 |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 0.40 | 0.17 | 0.66 | 1.00 | 2884.41 | 4013.61 |
| sd(Daily perceived persuasion target -> target) | 0.10 | 0.01 | 0.22 | 1.00 | 2405.40 | 3991.49 |
| sd(Daily perceived persuasion target -> agent) | 0.08 | 0.00 | 0.19 | 1.00 | 4821.21 | 5824.32 |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> agent) | NA | NA | NA | NA | NA | NA |
| Additional Parameters | ||||||
| ar[1] | 0.17 | 0.05 | 0.30 | 1.00 | 10072.24 | 8520.79 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | NA | NA | NA | NA | NA | NA |
| sigma | 1.02 | 0.94 | 1.10 | 1.00 | 9118.18 | 8182.69 |
introduce_binary_reactance <- function(data) {
data$is_reactance <- factor(data$reactance > 0, levels = c(FALSE, TRUE), labels = c(0, 1))
return(data)
}
df_double <- introduce_binary_reactance(df_double)
if (use_mi) {
for (i in seq_along(implist)) {
implist[[i]] <- introduce_binary_reactance(implist[[i]])
}
}
formula <- bf(
is_reactance ~
pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb +
day +
# Random effects
(pushing_self_cw + pushing_partner_cw +
pushing_self_cb + pushing_partner_cb | coupleID),
autocor = ~ ar(time = day, gr = coupleID:userID, p = 1)
)
prior1 <- c(
brms::set_prior("normal(0, 5)", class = "b"),
brms::set_prior("normal(0, 20)", class = "Intercept", lb=0, ub=5), # range of the outcome scale
brms::set_prior("normal(0, 2)", class = "sd", group = "coupleID", lb = 0),
brms::set_prior("cauchy(0, 5)", class = "ar", lb = -1, ub = 1)
#brms::set_prior("cauchy(0, 10)", class = "sigma", lb = 0)
)
df_minimal <- df_double[, c("userID", all.vars(as.formula(formula)))]
is_reactance <- my_brm(
mi = use_mi,
imputed_data = implist,
formula = formula,
prior = prior1,
data = df_double,
family = bernoulli(),
#control = list(adapt_delta = 0.95, max_treedepth = 15),
iter = 5000,
warmup = 2000,
chains = 4,
cores = 4,
seed = 7777,
file = file.path(working_directory, "models_cache", "is_reactance_onlyp")
)## Using 10 posterior draws for ppc type 'hist' by default.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Using 10 posterior draws for ppc type 'dens_overlay' by default.
##
## Computed from 12000 by 403 log-likelihood matrix.
##
## Estimate SE
## elpd_loo -321.8 16.6
## p_loo 255.0 14.0
## looic 643.6 33.2
## ------
## MCSE of elpd_loo is NA.
## MCSE and ESS estimates assume MCMC draws (r_eff in [0.2, 1.1]).
##
## Pareto k diagnostic values:
## Count Pct. Min. ESS
## (-Inf, 0.7] (good) 37 9.2% 196
## (0.7, 1] (bad) 242 60.0% <NA>
## (1, Inf) (very bad) 124 30.8% <NA>
## See help('pareto-k-diagnostic') for details.
summarize_brms(
is_reactance,
model_rows_fixed = model_rows_fixed,
model_rows_random = model_rows_random,
model_rownames_fixed = model_rownames_fixed,
model_rownames_random = model_rownames_random,
exponentiate = T) %>%
print_df(rows_to_pack = rows_to_pack)| OR | l-95% CI | u-95% CI | Rhat | Bulk_ESS | Tail_ESS | |
|---|---|---|---|---|---|---|
| Intercept | 0.09* | 0.01 | 0.38 | 1.003 | 1441.57 | 4709.80 |
| Within-Person Effects | ||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 2.06* | 1.07 | 6.05 | 1.003 | 1814.50 | 4135.14 |
| Daily perceived pushing target -> agent | 1.12 | 0.44 | 3.99 | 1.002 | 5340.99 | 4642.69 |
| Day | 3.34 | 0.27 | 73.41 | 1.000 | 4724.50 | 5891.27 |
| Daily weartime | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 425.78* | 14.60 | 32709.31 | 1.002 | 2387.77 | 6406.32 |
| Mean Perceived pushing target -> agent | 5.40 | 0.32 | 191.18 | 1.001 | 3211.48 | 6460.57 |
| Mean weartime | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||
| sd(Intercept) | 2.79 | 0.88 | 5.48 | 1.01 | 914.57 | 1454.65 |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.53 | 0.02 | 1.61 | 1.00 | 2248.22 | 5131.05 |
| sd(Daily perceived pushing target -> agent) | 0.86 | 0.05 | 2.38 | 1.00 | 2458.75 | 4696.52 |
| Additional Parameters | ||||||
| ar[1] | 0.37 | 0.03 | 0.87 | 1.00 | 1419.42 | 1470.87 |
| nu | NA | NA | NA | NA | NA | NA |
| shape | NA | NA | NA | NA | NA | NA |
| sderr | 4.09 | 1.25 | 7.92 | 1.01 | 686.66 | 880.36 |
| sigma | NA | NA | NA | NA | NA | NA |
if (report_ordinal) {
model_rows_random_final <- model_rows_random_ordinal
model_rows_fixed_final <- model_rows_fixed_ordinal
model_rownames_fixed_final <- model_rownames_fixed_ordinal
model_rownames_random_final <- model_rownames_random_ordinal
rows_to_pack_final <- rows_to_pack_ordinal
} else {
model_rows_random_final <- model_rows_random
model_rows_fixed_final <- model_rows_fixed
model_rownames_fixed_final <- model_rownames_fixed
model_rownames_random_final <- model_rownames_random
rows_to_pack_final <- rows_to_pack
}
all_models <- report_side_by_side(
pa_sub,
pa_obj_log,
mood,
reactance,
is_reactance,
model_rows_random = model_rows_random_final,
model_rows_fixed = model_rows_fixed_final,
model_rownames_random = model_rownames_random_final,
model_rownames_fixed = model_rownames_fixed_final
) ## [1] "pa_sub"
## [1] "pa_obj_log"
## [1] "mood"
## [1] "reactance"
## [1] "is_reactance"
# pretty printing
summary_all_models <- all_models %>%
print_df(rows_to_pack = rows_to_pack_final) %>%
add_header_above(
c(" ", "Subjective MVPA" = 2,
"Device-Based MVPA" = 2,
"Mood" = 2,
"Reactance Gaussian" = 2,
"Reactance Dichotome" = 2)
)
export_xlsx(summary_all_models,
rows_to_pack = rows_to_pack_final,
file.path(working_directory, "OutputFinal", "AllModels_onlyPushing.xlsx"), merge_option = 'both',
simplify_2nd_row = TRUE,
colwidths = c(40, 7.4, 12.85, 7.4, 12.85,7.4, 12.85,7.4, 12.85,7.4, 12.85),
line_above_rows = c(1,2,3,21),
line_below_rows = c(-1))
summary_all_models| IRR pa_sub | 95% CI pa_sub | exp(Est.) pa_obj_log | 95% CI pa_obj_log | b mood | 95% CI mood | b reactance | 95% CI reactance | OR is_reactance | 95% CI is_reactance | |
|---|---|---|---|---|---|---|---|---|---|---|
| Intercept | 51.60* | [38.12, 69.14] | 126.23* | [111.44, 143.02] | 4.78* | [ 4.55, 5.01] | 0.41* | [ 0.17, 0.66] | 0.09* | [ 0.01, 0.38] |
| Within-Person Effects | ||||||||||
| Daily perceived persuasion target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived pressure target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Daily perceived pushing target -> target | 1.10 | [ 0.98, 1.25] | 1.02 | [ 0.96, 1.08] | 0.03 | [-0.04, 0.09] | 0.11* | [ 0.03, 0.19] | 2.06* | [ 1.07, 6.05] |
| Daily perceived pushing target -> agent | 1.11 | [ 0.99, 1.26] | 1.03 | [ 0.99, 1.07] | 0.08* | [ 0.01, 0.15] | -0.03 | [-0.13, 0.06] | 1.12 | [ 0.44, 3.99] |
| Day | 0.66* | [ 0.49, 0.89] | 0.94 | [ 0.82, 1.07] | 0.27* | [ 0.07, 0.49] | 0.04 | [-0.37, 0.45] | 3.34 | [ 0.27, 73.41] |
| Daily weartime | NA | NA | 1.00* | [ 1.00, 1.00] | NA | NA | NA | NA | NA | NA |
| Between-Person Effects | ||||||||||
| Mean perceived persuasion target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived persuasion target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> target | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived pressure target -> agent | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| Mean Perceived pushing target -> target | 0.61* | [ 0.42, 0.88] | 0.98 | [ 0.85, 1.12] | 0.11 | [-0.13, 0.34] | 0.39* | [ 0.12, 0.66] | 425.78* | [14.60, 32709.31] |
| Mean Perceived pushing target -> agent | 0.56* | [ 0.38, 0.80] | 1.05 | [ 0.91, 1.20] | 0.11 | [-0.11, 0.35] | 0.26 | [-0.01, 0.54] | 5.40 | [ 0.32, 191.18] |
| Mean weartime | NA | NA | 1.00 | [ 1.00, 1.00] | NA | NA | NA | NA | NA | NA |
| Random Effects | ||||||||||
| sd(Intercept) | 0.74 | [ 0.53, 1.01] | 0.30 | [0.22, 0.40] | 0.60 | [0.46, 0.78] | 0.40 | [0.17, 0.66] | 2.79 | [0.88, 5.48] |
| sd(Daily perceived persuasion target -> target) | NA | NA | NA | NA | NA | NA | 0.10 | [0.01, 0.22] | NA | NA |
| sd(Daily perceived persuasion target -> agent) | NA | NA | NA | NA | NA | NA | 0.08 | [0.00, 0.19] | NA | NA |
| sd(Daily perceived pressure target -> target) | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pressure target -> agent) | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| sd(Daily perceived pushing target -> target) | 0.09 | [ 0.00, 0.24] | 0.10 | [0.03, 0.18] | 0.07 | [0.00, 0.16] | NA | NA | 0.53 | [0.02, 1.61] |
| sd(Daily perceived pushing target -> agent) | 0.09 | [ 0.00, 0.23] | 0.04 | [0.00, 0.11] | 0.10 | [0.01, 0.20] | NA | NA | 0.86 | [0.05, 2.38] |
| Additional Parameters | ||||||||||
| ar[1] | 0.04 | [-0.93, 0.94] | 0.27 | [0.21, 0.34] | 0.27 | [0.22, 0.33] | 0.17 | [0.05, 0.30] | 0.37 | [0.03, 0.87] |
| nu | NA | NA | NA | NA | NA | NA | NA | NA | NA | NA |
| shape | 0.43 | [ 0.40, 0.47] | NA | NA | NA | NA | NA | NA | NA | NA |
| sderr | 0.05 | [ 0.00, 0.13] | NA | NA | NA | NA | NA | NA | 4.09 | [1.25, 7.92] |
| sigma | NA | NA | 0.53 | [0.51, 0.55] | 0.89 | [0.85, 0.92] | 1.02 | [0.94, 1.10] | NA | NA |
Analyses were conducted using the R Statistical language (version 4.3.2; R Core Team, 2023) on Windows 11 x64 (build 22635)